home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / pvm34b3.zip / pvm34b3 / pvm3 / gexamples / frsg_g77.f next >
Text File  |  1997-08-08  |  7KB  |  229 lines
  1. c
  2. c $Id: frsg.f,v 1.1 1996/09/23 21:02:26 pvmsrc Exp $
  3. c
  4. c*----------------------------------------------------------------------
  5. c* Example of group Reduce, Scatter, and Gather functions - J.M. Donato
  6. c* 
  7. c* This example calculates the sum of squares of the first N integers
  8. c* in three different ways where 
  9. c*
  10. c*   N = (number of processors)*(number of elements per row)
  11. c*
  12. c* Note:  This is obviously not an efficient way to compute the 
  13. c*        sum of squares, but it is a cutesy example and test case.
  14. c*----------------------------------------------------------------------
  15. c  version frsg.f for g77  ... newline escape '\n' no '\'
  16. c  =======================================================
  17.       program main
  18.  
  19.       implicit none
  20.       include '../include/fpvm3.h'
  21.  
  22.       external PvmMin
  23.       external PvmMax
  24.       external PvmSum
  25.       external PvmProduct
  26.       external MaxWithLoc
  27.  
  28.       integer MAXNDATA, MAXNPROCS, DFLTNDATA, DFLTNPROCS
  29.       character*10 GROUP, TASK_NAME
  30.       parameter (MAXNDATA = 20, MAXNPROCS = 16, 
  31.      &           DFLTNDATA = 5, DFLTNPROCS = 4,
  32.      &           GROUP = 'grp_frsg', TASK_NAME = 'frsg')
  33.  
  34.       integer myginst, i, j, gsize, count, nprocs, msgtag, datatype,
  35.      &  buffer, info, info_product, info_user,
  36.      &  tids(MAXNPROCS), myrow(MAXNDATA), matrix(MAXNDATA*MAXNPROCS),
  37.      &  midpoint, bigN, Sum1, Sum2, SumSquares, rootginst,
  38.      &  PSum, PartSums(MAXNPROCS), dupls(MAXNDATA)
  39.  
  40.       double precision values(2)
  41.  
  42.       data Sum1/0/, Sum2/0/
  43.  
  44. c*  join the group 
  45.       call PvmfJoinGroup(GROUP, myginst)       
  46. c* I am the first group member, get input, start up copies of myself 
  47.       if ( myginst.eq.0 ) then 
  48.  
  49.         call PvmfMyTid(tids(1))
  50.         call PvmfParent(i)
  51.         if (i .eq. PvmNoParent) then
  52.             print *, '\n * Example: PVM Reduce, Scatter, and Gather * ',
  53.      &           '\n Number of processors to use (1-', MAXNPROCS,')? : '
  54.             read *, nprocs
  55.             if (nprocs.gt.MAXNPROCS) nprocs = MAXNPROCS
  56.                  print *, ' Number of elements per row to use (1-', 
  57.      &             MAXNDATA, ')? : '
  58.              read *, count
  59.             if (count.gt.MAXNDATA) count = MAXNDATA
  60.         else
  61.             nprocs = DFLTNPROCS
  62.             count = DFLTNDATA
  63.         endif
  64.         print *, ' INPUT values: nprocs = ', nprocs, ', count = ', count
  65.  
  66.         if ( nprocs.gt.1 ) then 
  67.           call PvmfSpawn(TASK_NAME, PvmDefault, '*', 
  68.      &                   nprocs-1, tids(2), info)
  69.  
  70. c*  wait until they have all started, then send input values 
  71.           call PvmfGsize(GROUP, gsize)
  72. 9000      continue
  73.           if ( gsize.lt.nprocs) then
  74.             call sleep(1) 
  75.             call PvmfGsize(GROUP, gsize)
  76.             go to 9000
  77.           end if
  78.  
  79.           call PvmfInitsend(PvmDataDefault, buffer)
  80.           call PvmfPack(INTEGER4, nprocs, 1, 1, info)
  81.           call PvmfPack(INTEGER4, count,  1, 1, info)
  82.           msgtag = 17
  83.           call PvmfBcast(GROUP, msgtag, info)
  84.         end if
  85.  
  86.       else
  87. c*  receive the input values if child node
  88.         msgtag = 17
  89.         call PvmfRecv(-1, msgtag, info)
  90.         call PvmfUnpack(INTEGER4, nprocs, 1, 1, info)
  91.         call PvmfUnpack(INTEGER4, count,  1, 1, info)
  92.       end if
  93.   
  94. c*  determine the group root 
  95.       rootginst = 0
  96.  
  97. c*  init the matrix values on the root processor 
  98.       if ( myginst.eq.rootginst ) then
  99.         do j=1, nprocs
  100.           do i=1, count
  101.             matrix((j-1)*count + i) = (j-1)*count + i
  102.           end do
  103.         end do
  104.       end if
  105.  
  106. c*  scatter rows of matrix to each processor 
  107.       msgtag = 19
  108.       call PvmfScatter(myrow, matrix, count, INTEGER4, msgtag, 
  109.      &                 GROUP, rootginst, info)
  110.  
  111. c*  this should end up squaring each value on each processor 
  112.       do i=1, count
  113.         dupls(i) = myginst*count + i 
  114.       end do
  115.       datatype = INTEGER4
  116.       call PvmProduct(datatype, myrow, dupls, count, info_product)
  117.       if ((myginst.eq.rootginst).and.(info_product.lt.0))
  118.      &    print *, ' ERROR: ', info_product, ' on PvmProduct call '
  119.  
  120. c*  do partial sum on each proc 
  121.       do i=1, count
  122.         PSum = PSum + myrow(i)
  123.       end do
  124.  
  125. c*  gather partial sums to the rootginst 
  126.       msgtag = 21
  127.       call PvmfGather(PartSums, PSum, 1, INTEGER4, msgtag, 
  128.      &                GROUP, rootginst, info)
  129.  
  130. c*  do a global sum over myrow, the result goes to rootginst 
  131.       msgtag = 23
  132.       call PvmfReduce(PvmSum, myrow, count, INTEGER4, msgtag, 
  133.      &                GROUP, rootginst, info)
  134.  
  135. c*  init values and include location information on each processor 
  136.       midpoint = nprocs/2
  137.       values(1) = -(myginst - midpoint)*(myginst-midpoint) + count
  138.       values(2) = myginst    
  139.  
  140. c*  use a user-defined function in reduce, send answer to rootginst 
  141.       msgtag = 25
  142.       call PvmfReduce(MaxWithLoc, values, 2, REAL8, 
  143.      &                msgtag, GROUP, rootginst, info_user)
  144.  
  145.       bigN = nprocs*count
  146.       if (myginst.eq.rootginst) then
  147. c*  Complete the Sum of Squares using different methods 
  148.         do i=1, nprocs
  149.           Sum1 = Sum1 + PartSums(i) 
  150.         end do
  151.         do i=1, count 
  152.           Sum2 = Sum2 + myrow(i)    
  153.         end do
  154.         SumSquares = bigN*(bigN+1)*(2*bigN+1)/6
  155.         if ( (Sum1.eq.SumSquares) .and. (Sum2.eq.SumSquares)) then
  156.           print *, '\n Test OK: Sum of Squares of first ', bigN, 
  157.      &             ' integers is ', Sum1
  158.         else
  159.           print *, '\n ERROR: The Sum of Squares of the first ', bigN, 
  160.      &             ' integers \n was calculated by Sum1 as ', Sum1,
  161.      &             ' and by Sum2 as ', Sum2,
  162.      &             ' for both it should have been ', SumSquares
  163.         end if
  164.  
  165.         if (info_user.lt.0) 
  166.      &    print *, ' ERROR: ', info_user, ' on User Reduce Function'
  167.  
  168.         if ((values(1).ne.count) .or. (values(2).ne.midpoint)) then
  169.           print *, ' ERROR: Should have (', count, ', ', midpoint,
  170.      &             '), but have (', values(1), ',', values(2)
  171.         else
  172.           print *, ' Test Ok: Received (', values(1), ',', 
  173.      &              values(2), ') '
  174.         end if
  175.  
  176.       end if
  177.        
  178.  
  179. c*  sync up again, leave group, exit pvm 
  180.       call PvmfBarrier(GROUP, nprocs, info)   
  181.       call PvmfLvgroup(GROUP, info)
  182.       call PvmfExit(info)
  183.  
  184.       stop
  185.       end
  186.  
  187.  
  188. c*
  189. c* This function returns the elementwise maximum of two vectors 
  190. c* along with location information.
  191. c*
  192. c* The first num/2 values of x and y are the data values to compare.
  193. c* The second num/2 values of x and y are location information
  194. c* which is kept with the maximum value determined.
  195. c*
  196. c* In the case of a tie in data values, the smaller location 
  197. c* is kept to insure the associativity of the operation.
  198. c*
  199.  
  200.       subroutine MaxWithLoc(datatype, x, y, num, info)
  201.       implicit none
  202.       integer datatype, num, info
  203.       double precision x(*), y(*)
  204.  
  205.       include '../include/fpvm3.h'
  206.  
  207.       integer i, count
  208.       count = num/2
  209.  
  210.       if (datatype.ne.REAL8) then
  211.         info = PvmBadParam 
  212.         return
  213.       end if
  214.  
  215.       do i=1, count
  216.         if (y(i).gt.x(i)) then
  217.           x(i)       = y(i)
  218.           x(i+count) = y(i+count)
  219.         elseif (y(i).eq.x(i)) then
  220.           x(i+count) = min(x(i+count), y(i+count))
  221.         end if
  222.       end do
  223.  
  224.       info = PvmOk
  225.       return
  226.       end
  227.  
  228.  
  229.